home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp2.arc
/
PIBHOSTC.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1985-10-03
|
28KB
|
736 lines
(*----------------------------------------------------------------------*)
(* Second host mode overlay section starts here *)
(*----------------------------------------------------------------------*)
CONST
Start_Host_Overlay_Two = 1;
(*----------------------------------------------------------------------*)
(* Do_Host --- Controls execution of host mode *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Do_Host;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Do_Host *)
(* *)
(* Purpose: Controls host mode *)
(* *)
(* Calling Sequence: *)
(* *)
(* Do_Host; *)
(* *)
(* Calls: Async_Send *)
(* Async_Receive *)
(* KeyPressed *)
(* Process_Command *)
(* ClrScr *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Done : BOOLEAN (* TRUE to exit host mode *);
Found : BOOLEAN (* TRUE if user name found *);
Ch : CHAR (* Character read/written *);
S_Ch : CHAR (* Parity_stripped character *);
MyPass : AnyStr (* Password *);
Try : INTEGER (* Number of login attempts *);
Back : BOOLEAN (* Back from file transfers *);
BEGIN (* Do_Host *)
(* Clear comm line of garbage *)
Async_Purge_Buffer;
(* Expert mode OFF by default *)
Expert_On := FALSE;
(* Assume line feeds not needed *)
CR_LF_Host := CHR( CR );
(* Welcome and linefeed check *)
Done := FALSE;
Host_Send_String_With_CR('PibTerm V3.0, October, 1985');
Host_Send_String_With_CR('Beginning Remote Communications');
Host_Send_String_With_CR(' ');
Host_Send_String_With_CR('Test if line feeds required ...');
REPEAT
Async_Purge_Buffer;
Host_Send_String_With_CR(' ');
Host_Send_String_And_Echo('Are these lines O V E R P R I N T I N G ?');
REPEAT
UNTIL Async_Receive( Ch ) OR KeyPressed OR ( NOT Host_Carrier_Detect );
S_Ch := CHR( ORD( Ch ) AND $7F );
(* Alter parity if required *)
IF ( S_Ch <> Ch ) THEN
BEGIN
IF Parity = 'N' THEN
BEGIN
Parity := 'E';
Data_Bits := 7;
END
ELSE
BEGIN
Parity := 'N';
Data_Bits := 8;
END;
Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
Data_Bits, Stop_Bits );
WRITELN;
WRITELN('Communication re-adjusted to parity = ',Parity,
' and data bits = ',Data_Bits);
WRITELN;
END;
(* Look for keyboard input if any *)
IF KeyPressed THEN
BEGIN
READ( KBD, S_Ch );
IF ( S_Ch = CHR( ESC ) ) THEN
Done := TRUE;
END;
IF ( NOT Done ) THEN
BEGIN
S_Ch := UpCase( S_Ch );
Host_Send( S_Ch );
IF Printer_On THEN
WRITE( Lst , S_Ch );
IF Capture_On THEN
WRITE( Capture_File , S_Ch );
END;
Done := Done OR ( NOT Host_Carrier_Detect );
UNTIL ( S_Ch IN ['Y','N'] ) OR Done;
IF Done THEN Exit;
IF S_Ch = 'Y' THEN
CR_LF_Host := CHR( CR ) + CHR( LF )
ELSE
CR_LF_Host := CHR( CR );
(* Get user's ID and password *)
Try := 0;
REPEAT
Try := Try + 1;
Get_UserInfo( Found );
UNTIL( ( Try > Max_Login_Try ) OR Found );
(* Check for bad logon or carrier drop *)
Done := Done OR ( NOT Found ) OR ( NOT Host_Carrier_Detect );
(* Continue to main menu if OK *)
IF ( NOT Done ) THEN
BEGIN
(* Mark this as first entry here *)
Host_Section := 'I';
(* Loop over main menu until done *)
REPEAT
IF Host_Section <> 'F' THEN
Process_Host_Commands( Done )
ELSE
REPEAT
Process_File_Transfer_Commands( Done, Back );
UNTIL( Done OR Back );
Done := Done OR ( NOT Host_Carrier_Detect );
UNTIL ( Done );
END;
(* Open log file and record this logout *)
ASSIGN( Log_File, 'PIBTERM.LOG' );
(*$I-*)
RESET ( Log_File );
(*$I+*)
IF Int24Result = 0 THEN
BEGIN
CLOSE( Log_File );
APPEND( Log_File );
END
ELSE
REWRITE( Log_File );
WRITELN( Log_File,'----- Logged off at ',TimeString( TimeOfDay ),' on ',
DateString );
(*$I-*)
CLOSE( Log_File );
(*$I+*)
END (* Do_Host *);
(*----------------------------------------------------------------------*)
(* Initialize_Host_Mode --- Initializes host mode *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Initialize_Host_Mode;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Initialize_Host_Mode *)
(* *)
(* Purpose: Initializes host mode. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Initialize_Host_Mode; *)
(* *)
(* Remarks: *)
(* *)
(* This routine reads the user file into memory and scans the *)
(* message file as well. The asynchronous communications port *)
(* is also initialized. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Qerr : BOOLEAN;
User_Line: AnyStr;
I : INTEGER;
Done_Flag: BOOLEAN;
(*----------------------------------------------------------------------*)
(* Get_A_String --- get string up to specified delimeter *)
(*----------------------------------------------------------------------*)
FUNCTION Get_A_String( S : AnyStr; VAR IS: INTEGER; Delim: CHAR ) : AnyStr;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Get_A_String *)
(* *)
(* Purpose: Gets string up to specified delimeter. *)
(* *)
(* Calling Sequence: *)
(* *)
(* D_String := Get_A_String( S : AnyStr; VAR IS: INTEGER; *)
(* Delim: CHAR ) : AnyStr; *)
(* *)
(* S --- string to be scanned *)
(* IS --- first position in S to be scanned *)
(* Delim --- delimeter character to mark end of string *)
(* *)
(* D_String --- returns substring of S beginning at IS and *)
(* proceeding up to (but not including) Delim, *)
(* or end of string. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
T: AnyStr;
BEGIN (* Get_A_String *)
T := '';
WHILE ( IS <= LENGTH( S ) ) AND ( S[IS] <> Delim ) DO
BEGIN
T := T + S[IS];
IS := IS + 1;
END;
Get_A_String := T;
END (* Get_A_String *);
(*----------------------------------------------------------------------*)
BEGIN (* Initialize_Host_Mode *)
ClrScr;
(* Initialize communications *)
Async_Init;
Qerr := Async_Open( Comm_Port, Baud_Rate,
Parity, Data_Bits, Stop_Bits );
(* Set the modem *)
Send_Modem_Command( Modem_Host_Set );
DELAY( One_Second_Delay );
Async_Purge_Buffer;
(* Read in the user file *)
ASSIGN( User_File, Home_Dir + 'PIBTERM.USF' );
(*$I-*)
RESET ( User_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN
WRITELN(' ');
WRITELN('Can''t open user file, host session ended.');
WRITELN(' ');
Really_Done := TRUE;
END
ELSE
BEGIN
NUsers := 0;
REPEAT
NUsers := NUsers + 1;
READLN( User_File , User_Line );
WITH User_List[NUsers] DO
BEGIN
I := 1;
First_Name := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
I := I + 1;
Last_Name := Trim( UpperCase( Get_A_String( User_Line, I, ';') ) );
I := I + 1;
PassWord := Trim( Get_A_String( User_Line, I, ';') );
END;
UNTIL ( EOF( User_File ) OR ( NUsers >= MaxUsers ) );
(*$I-*)
CLOSE( User_File );
(*$I+*)
WRITELN('There are ',NUsers,' users recorded in user file.');
END;
(* Scan message file to see how *)
(* many messages there are *)
NMessages := 0;
ASSIGN( Message_File , Home_Dir + 'PIBTERM.MSG' );
(*$I-*)
RESET( Message_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN
WRITELN('No messages in message base.');
END
ELSE
REPEAT
READLN( Message_File , Message_Line );
IF COPY( Message_Line, 1, 6 ) = '== End' THEN
NMessages := NMessages + 1;
UNTIL ( EOF( Message_File ) );
IF NMessages > 0 THEN
WRITELN('There are ', NMessages,' messages in message base.');
(*$I-*)
CLOSE( Message_File );
(*$I+*)
END (* Initialize_Host_Mode *);
(*----------------------------------------------------------------------*)
(* Terminate_Host_Mode --- Terminate host mode *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Terminate_Host_Mode;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Terminate_Host_Mode *)
(* *)
(* Purpose: Terminates host mode. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Terminate_Host_Mode; *)
(* *)
(* Remarks: *)
(* *)
(* This routine hangs up the phone. *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Terminate_Host_Mode *)
(* Hang up the phone *)
IF ( NOT Local_Host ) THEN
HangUpPhone;
WRITELN;
WRITELN('Host session ended.');
END (* Terminate_Host_Mode *);
(*----------------------------------------------------------------------*)
(* Wait_For_Ring --- Wait for phone to ring and answer it *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Wait_For_Ring( VAR Done: BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Wait_For_Ring *)
(* *)
(* Purpose: Answers the phone in host mode. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Wait_For_Ring( VAR Done : BOOLEAN ); *)
(* *)
(* Done -- set TRUE if carrier drops or Sysop requests *)
(* host mode termination. *)
(* *)
(* Remarks: *)
(* *)
(* This routine answers the phone and analyzes the modem response *)
(* in order to set the proper baud rate for communications. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Qerr: BOOLEAN;
Modem_Ans: AnyStr;
Ch: CHAR;
I: INTEGER;
J: INTEGER;
MTimeOut: BOOLEAN;
Int_Ch: INTEGER;
(*----------------------------------------------------------------------*)
(* Host_Baud_Detect --- Detect caller's baud rate from CRs *)
(*----------------------------------------------------------------------*)
PROCEDURE Host_Baud_Detect;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Host_Baud_Detect *)
(* *)
(* Purpose: Detects caller's baud rate from CR entries *)
(* *)
(* Calling Sequence: *)
(* *)
(* Host_Baud_Detect; *)
(* *)
(* Calls: *)
(* *)
(* Async_Receive_With_TimeOut *)
(* *)
(* Remarks: *)
(* *)
(* The initial baud rate is set to 300 baud. Then, as the *)
(* enters characters, we look at each and alter the baud rate *)
(* until something recognizable emerges. *)
(* *)
(*----------------------------------------------------------------------*)
CONST
Wait_Ch_Time = 1 (* Seconds to wait for a character *);
(* Supported host mode baud rates *)
N_Of_Host_Baud_Rates = 3;
Host_Baud_Rates : ARRAY[1..N_Of_Host_Baud_Rates] OF INTEGER
= ( 2400, 1200, 300 );
VAR
Found_Speed : BOOLEAN;
IBaud : INTEGER;
(*----------------------------------------------------------------------*)
(* Try_Baud_Rate --- Try a specified baud rate *)
(*----------------------------------------------------------------------*)
FUNCTION Try_Baud_Rate( Test_Baud_Rate: INTEGER ) : BOOLEAN;
VAR
Stripped_Ch : INTEGER;
Timed_Out : BOOLEAN;
Ch : INTEGER;
BEGIN (* Try_Baud_Rate *)
(* Assume this baud rate fails *)
Try_Baud_Rate := FALSE;
(* Set port to given baud rate *)
Baud_Rate := Test_Baud_Rate;
Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
(* Wait for a character *)
Async_Receive_With_TimeOut( Wait_Ch_Time , Ch );
Timed_Out := ( Ch = TimeOut );
Async_Clear_Errors;
(* Strip parity bit *)
Stripped_Ch := ( Ch AND $7F );
(* See if it's recognizable as CR *)
(* or space. If so, then check *)
(* the parity. *)
IF ( NOT Timed_Out ) THEN
IF ( Stripped_Ch = CR ) OR
( Stripped_Ch = ORD(' ') ) THEN
BEGIN
Try_Baud_Rate := TRUE;
IF ( Stripped_Ch <> Ch ) THEN
BEGIN
IF Parity = 'N' THEN
BEGIN
Parity := 'E';
Data_Bits := 7;
END
ELSE
BEGIN
Parity := 'N';
Data_Bits := 8;
END;
Async_Reset_Port( Comm_Port, Baud_Rate, Parity,
Data_Bits, Stop_Bits );
END;
END;
END (* Try_Baud_Rate *);
(*----------------------------------------------------------------------*)
BEGIN (* Host_Baud_Detect *)
(* Indicates if speed detected *)
Found_Speed := FALSE;
(* Wait for modem messages to appear *)
DELAY( 2 * Tenth_Of_A_Second_Delay );
(* Purge the receive buffer *)
Async_Purge_Buffer;
(* Loop until speed found *)
WHILE ( NOT Found_Speed ) AND ( Async_Carrier_Detect ) DO
BEGIN
IBaud := 0;
(* Try each baud rate in turn *)
REPEAT
IBaud := IBaud + 1;
Parity := 'N';
Data_Bits := 8;
Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );
UNTIL ( Found_Speed ) OR ( IBaud >= N_Of_Host_Baud_Rates );
(* If we found the speed, try *)
(* getting a second character. *)
(* If it's not recognizable, *)
(* then it didn't work. *)
IF Found_Speed THEN
Found_Speed := Try_Baud_Rate( Host_Baud_Rates[IBaud] );
(* If we didn't get the speed, *)
(* flush the buffer before next *)
(* try. *)
IF ( NOT Found_Speed ) THEN
BEGIN
DELAY( 5 );
Async_Purge_Buffer;
END;
END (* WHILE *);
(* Flush the buffer once more *)
DELAY( Tenth_Of_A_Second_Delay );
Async_Purge_Buffer;
WRITELN('Communications adjusted to ',Baud_Rate,' baud and parity = ',
Parity );
END (* Host_Baud_Detect *);
(*----------------------------------------------------------------------*)
(* Host_AutoBaud_Detect --- Detect caller's baud rate from modem *)
(*----------------------------------------------------------------------*)
PROCEDURE Host_AutoBaud_Detect;
VAR
New_Baud: INTEGER;
BEGIN (* Host_AutoBaud_Detect *)
New_Baud := 0;
J := POS( Modem_Connect, Modem_Ans ) + LENGTH( Modem_Connect );
FOR I := J TO LENGTH( Modem_Ans ) DO
IF Modem_Ans[I] IN ['0'..'9'] THEN
New_Baud := New_Baud * 10 + ORD( Modem_Ans[I] ) - ORD('0');
IF New_Baud = 0 THEN New_Baud := 300;
IF New_Baud > 0 THEN
BEGIN
Baud_Rate := New_Baud;
Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits, Stop_Bits );
WRITELN('Communications adjusted to ',Baud_Rate,' baud.');
END;
END (* Host_AutoBaud_Detect *);
(*----------------------------------------------------------------------*)
BEGIN (* Wait_For_Ring *)
(* Nothing from modem yet *)
Modem_Ans := '';
(* Assume remote session *)
Local_Host := FALSE;
(* Raise terminal ready *)
Async_Term_Ready( TRUE );
(* Not done yet *)
Done := FALSE;
(* Display intro blurb *)
WRITELN('Waiting for phone to ring.');
WRITELN('Hit ESC key to return to terminal mode.');
WRITELN('F1 starts/stops chat mode.');
WRITELN('F2 immediately logs out remote user.');
WRITELN('Hit any other key to start local host session.');
(* Remove any pending input *)
Async_Purge_Buffer;
REPEAT (* Wait for ring/carrier detect *)
IF KeyPressed THEN
BEGIN
READ( Kbd, Ch );
IF Ch = CHR( ESC ) THEN
BEGIN
IF KeyPressed THEN
Local_Host := TRUE
ELSE
Done := TRUE;
END
ELSE
Local_Host := TRUE;
END;
UNTIL ( Host_Carrier_Detect ) OR Done OR Local_Host;
IF Done THEN Really_Done := TRUE;
(* If local host session, *)
(* turn off terminal ready *)
(* so phone isn't answered. *)
IF Local_Host THEN
BEGIN
WRITELN('Local host session begins ... ');
Async_Term_Ready( FALSE );
EXIT;
END;
IF NOT Done THEN
BEGIN (* Answer the phone *)
WRITELN('Answered phone ... ');
(*---------------------------------------------------------------*)
(* *)
(* ----- Let the modem answer the phone ----- *)
(* *)
(* Send_Modem_Command( Modem_Answer ); *)
(* *)
(*---------------------------------------------------------------*)
DELAY( One_Second_Delay );
(* Collect modem response for *)
(* later analysis. *)
MTimeOut := FALSE;
REPEAT
Async_Receive_With_TimeOut( 1 , Int_Ch );
IF Int_Ch <> TimeOut THEN
BEGIN
Ch := CHR( Int_Ch );
IF Ch IN ['A'..'Z',' ','0'..'9'] THEN
Modem_Ans := Modem_Ans + Ch;
WRITE( Ch );
IF Printer_On THEN
WRITE( Lst , Ch );
IF Capture_On THEN
WRITE( Capture_File , Ch );
END
ELSE
MTimeOut := TRUE;
UNTIL ( MTimeOut OR Done );
(* Find speed for caller's modem. *)
IF ( NOT Done ) THEN
IF Host_Auto_Baud THEN
Host_AutoBaud_Detect
ELSE
Host_Baud_Detect;
END (* NOT Done *);
Done := Done OR ( NOT Host_Carrier_Detect );
END (* Wait_For_Ring *);
(*----------------------------------------------------------------------*)
(* Emulate_Host_Mode --- main routine for host mode *)
(*----------------------------------------------------------------------*)
BEGIN (* Emulate_Host_Mode *)
Host_Mode := TRUE;
Done := FALSE;
Really_Done := FALSE;
First_Time := TRUE;
(* Initialize host mode *)
Initialize_Host_Mode;
IF ( NOT Really_Done ) THEN
REPEAT
(* Wait for call *)
Wait_For_Ring( Done );
(* Do a host session *)
IF NOT Done THEN Do_Host;
(* End host session *)
Terminate_Host_Mode;
UNTIL Really_Done;
WRITELN(' ');
WRITELN('Host mode communications closed down, ');
WRITELN('returning to terminal emulation mode. ');
(* Restore previous terminal type *)
Terminal_To_Emulate := Saved_Gossip_Term;
Host_Mode := FALSE;
END (* Emulate_Host_Mode *);
